home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form JuliaForm
- Caption = "Mandelbrot"
- ClientHeight = 3810
- ClientLeft = 2460
- ClientTop = 1320
- ClientWidth = 3810
- Height = 4500
- Left = 2400
- LinkTopic = "Form1"
- ScaleHeight = 254
- ScaleMode = 3 'Pixel
- ScaleWidth = 254
- Top = 690
- Width = 3930
- Begin VB.PictureBox Canvas
- AutoRedraw = -1 'True
- BackColor = &H00000000&
- DrawMode = 6 'Mask Pen Not
- Height = 3810
- Left = 0
- MousePointer = 2 'Cross
- Picture = "JULIA.frx":0000
- ScaleHeight = 250
- ScaleMode = 3 'Pixel
- ScaleWidth = 250
- TabIndex = 0
- Top = 0
- Width = 3810
- End
- Begin MSComDlg.CommonDialog FileDialog
- Left = 2880
- Top = 3600
- _Version = 65536
- _ExtentX = 847
- _ExtentY = 847
- _StockProps = 0
- CancelError = -1 'True
- End
- Begin VB.Menu mnuFile
- Caption = "&File"
- Begin VB.Menu mnuFileSaveAs
- Caption = "&Save As..."
- Shortcut = ^A
- End
- Begin VB.Menu mnuFileSep
- Caption = "-"
- End
- Begin VB.Menu mnuFileExit
- Caption = "E&xit"
- End
- End
- Begin VB.Menu mnuScaleMnu
- Caption = "&Scale"
- Begin VB.Menu mnuScale
- Caption = "x&2"
- Index = 2
- End
- Begin VB.Menu mnuScale
- Caption = "x&4"
- Index = 4
- End
- Begin VB.Menu mnuScale
- Caption = "x&8"
- Index = 8
- End
- Begin VB.Menu mnuScaleFull
- Caption = "&Full Scale"
- End
- End
- Begin VB.Menu mnuOpt
- Caption = "&Options"
- Begin VB.Menu mnuOptJulia
- Caption = "&Julia"
- End
- Begin VB.Menu mnuOptMandelbrot
- Caption = "&Mandelbrot"
- Checked = -1 'True
- End
- Begin VB.Menu mnuOptIter
- Caption = "&Iterations..."
- End
- Begin VB.Menu mnuOptColors
- Caption = "&Colors..."
- End
- End
- Begin VB.Menu mnuMovie
- Caption = "&Movie"
- Begin VB.Menu mnuMovieCreate
- Caption = "&Create Movie..."
- End
- End
- Attribute VB_Name = "JuliaForm"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Dim DrawingBox As Boolean
- Dim StartX As Single
- Dim StartY As Single
- Dim CurX As Single
- Dim CurY As Single
- Dim Xmin As Single
- Dim Xmax As Single
- Dim Ymin As Single
- Dim Ymax As Single
- Dim MaxWid As Single
- Dim MaxHgt As Single
- Dim DrawingJulia As Boolean
- Dim ReaC As Double
- Dim ImaC As Double
- Dim MaxIter As Integer
- Dim NumClrs As Integer
- Dim ok_clr() As Integer
- ' ************************************************
- ' Draw the appropriate curve.
- ' ************************************************
- Sub DrawCurve()
- If DrawingJulia Then
- DrawJulia
- Else
- DrawMandelbrot
- End If
- End Sub
- ' ************************************************
- ' Return the number of colors in use.
- ' ************************************************
- Property Get NumColors() As Integer
- NumColors = NumClrs
- End Property
- ' ************************************************
- ' Return the value of the indicated color.
- ' ************************************************
- Property Get OkClr(index As Integer) As Integer
- OkClr = ok_clr(index)
- End Property
- ' ***********************************************
- ' Make Canvas's palette contain the system static
- ' colors so the colors are saved to files with
- ' the image.
- ' ***********************************************
- Sub PreparePalette(pic As Control)
- Dim SysPalSize As Integer
- Dim NumStaticColors As Integer
- Dim StaticColor1 As Integer
- Dim StaticColor2 As Integer
- Dim offset As Integer
- Dim LogPal As Integer
- Dim palentry(0 To 255) As PALETTEENTRY
- Dim sys(0 To 255) As PALETTEENTRY
- Dim i As Integer
- ' Make sure the screen supports palettes.
- If Not GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE Then
- Beep
- MsgBox "This monitor does not support palettes.", _
- vbCritical
- End
- End If
- ' Get system palette size and # static colors.
- SysPalSize = GetDeviceCaps(hdc, SIZEPALETTE)
- NumStaticColors = GetDeviceCaps(hdc, NUMRESERVED)
- StaticColor1 = NumStaticColors \ 2 - 1
- StaticColor2 = SysPalSize - NumStaticColors \ 2
- ' Make sure pic has the foreground palette.
- pic.ZOrder
- i = RealizePalette(pic.hdc)
- DoEvents
- ' Get the system palette entries.
- i = GetSystemPaletteEntries(pic.hdc, 0, SysPalSize, sys(0))
-
- ' Make the logical palette as big as possible.
- LogPal = pic.Picture.hPal
- If ResizePalette(LogPal, NumStaticColors) = 0 Then
- Beep
- MsgBox "Error resizing logical palette.", _
- vbExclamation
- Exit Sub
- End If
- ' Insert the system static colors.
- For i = 0 To StaticColor1
- palentry(i) = sys(i)
- Next i
- offset = StaticColor2 - StaticColor1 - 1
- For i = StaticColor2 To 255
- palentry(i - offset) = sys(i)
- Next i
- i = SetPaletteEntries(LogPal, 0, NumStaticColors, palentry(0))
- ' Realize the new palette.
- i = RealizePalette(pic.hdc)
- End Sub
- ' ************************************************
- ' Adjust the aspect ratio of the selected
- ' coordinates so they fit the window properly.
- ' ************************************************
- Sub AdjustAspect()
- Dim want_aspect As Single
- Dim canvas_aspect As Single
- Dim hgt As Single
- Dim wid As Single
- Dim mid As Single
- want_aspect = (Ymax - Ymin) / (Xmax - Xmin)
- canvas_aspect = Canvas.ScaleHeight / Canvas.ScaleWidth
- If want_aspect > canvas_aspect Then
- ' The selected area is too tall and thin.
- ' Make it wider.
- wid = (Ymax - Ymin) / canvas_aspect
- mid = (Xmin + Xmax) / 2
- Xmin = mid - wid / 2
- Xmax = mid + wid / 2
- Else
- ' The selected area is too short and wide.
- ' Make it taller.
- hgt = (Xmax - Xmin) * canvas_aspect
- mid = (Ymin + Ymax) / 2
- Ymin = mid - hgt / 2
- Ymax = mid + hgt / 2
- End If
- End Sub
- ' ************************************************
- ' Draw the Mandelbrot set.
- ' ************************************************
- Sub DrawMandelbrot()
- Const MAX_MAG_SQUARED = 4 ' Work until the magnitude squared > 4.
- Dim bm As BITMAP
- Dim hbm As Integer
- Dim status As Long
- Dim bytes() As Byte
- Dim wid As Long
- Dim hgt As Long
- Dim clr As Long
- Dim i As Integer
- Dim j As Integer
- Dim ReaC As Double
- Dim ImaC As Double
- Dim dReaC As Double
- Dim dImaC As Double
- Dim ReaZ As Double
- Dim ImaZ As Double
- Dim ReaZ2 As Double
- Dim ImaZ2 As Double
- WaitStart
- AdjustAspect
- ' Get the image pixels.
- hbm = Canvas.Image
- status = GetObject(hbm, 14, bm)
- wid = bm.bmWidthBytes
- hgt = bm.bmHeight
- ReDim bytes(1 To wid, 1 To hgt)
- ' dReaC is the change in the real part
- ' (X value) for C. dImaC is the change in the
- ' imaginary part (Y value).
- dReaC = (Xmax - Xmin) / (wid - 1)
- dImaC = (Ymax - Ymin) / (hgt - 1)
- ' Calculate the values.
- ReaC = Xmin
- For i = 1 To wid
- ImaC = Ymin
- For j = 1 To hgt
- ReaZ = 0
- ImaZ = 0
- ReaZ2 = 0
- ImaZ2 = 0
- clr = 1
- Do While clr < MaxIter And _
- ReaZ2 + ImaZ2 < MAX_MAG_SQUARED
- ' Calculate Z(clr).
- ReaZ2 = ReaZ * ReaZ
- ImaZ2 = ImaZ * ImaZ
- ImaZ = 2 * ImaZ * ReaZ + ImaC
- ReaZ = ReaZ2 - ImaZ2 + ReaC
- clr = clr + 1
- Loop
- bytes(i, j) = ok_clr(clr Mod NumClrs)
- ImaC = ImaC + dImaC
- Next j
- ReaC = ReaC + dReaC
- Next i
- ' Update the image.
- status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
- Canvas.Refresh
- Caption = "Mandelbrot (" & Format$(Xmin) & ", " & Format$(Ymin) & ")-(" & Format$(Xmax) & ", " & Format$(Ymax) & ")"
- WaitEnd
- End Sub
- ' ************************************************
- ' Draw the Julia set.
- ' ************************************************
- Sub DrawJulia()
- Const MAX_MAG_SQUARED = 4 ' Work until the magnitude squared > 4.
- Dim bm As BITMAP
- Dim hbm As Integer
- Dim status As Long
- Dim bytes() As Byte
- Dim wid As Long
- Dim hgt As Long
- Dim clr As Long
- Dim i As Integer
- Dim j As Integer
- Dim dReaZ0 As Double
- Dim dImaZ0 As Double
- Dim ReaZ0 As Double
- Dim ImaZ0 As Double
- Dim ReaZ As Double
- Dim ImaZ As Double
- Dim ReaZ2 As Double
- Dim ImaZ2 As Double
- WaitStart
- AdjustAspect
- ' Get the image pixels.
- hbm = Canvas.Image
- status = GetObject(hbm, 14, bm)
- wid = bm.bmWidthBytes
- hgt = bm.bmHeight
- ReDim bytes(1 To wid, 1 To hgt)
- ' dReaZ0 is the change in the real part
- ' (X value) for Z(0). dImaZ0 is the change in
- ' the imaginary part (Y value).
- dReaZ0 = (Xmax - Xmin) / (wid - 1)
- dImaZ0 = (Ymax - Ymin) / (hgt - 1)
- ' Calculate the values.
- ReaZ0 = Xmin
- For i = 1 To wid
- ImaZ0 = Ymin
- For j = 1 To hgt
- ReaZ = ReaZ0
- ImaZ = ImaZ0
- ReaZ2 = ReaZ * ReaZ
- ImaZ2 = ImaZ * ImaZ
- clr = 1
- Do While clr < MaxIter And _
- ReaZ2 + ImaZ2 < MAX_MAG_SQUARED
- ' Calculate Z(clr).
- ReaZ2 = ReaZ * ReaZ
- ImaZ2 = ImaZ * ImaZ
- ImaZ = 2 * ImaZ * ReaZ + ImaC
- ReaZ = ReaZ2 - ImaZ2 + ReaC
- clr = clr + 1
- Loop
-
- If clr >= MaxIter Then
- ' Use a non-background color.
- bytes(i, j) = _
- ok_clr(((ReaZ2 + ImaZ2) * (NumClrs - 1)) Mod _
- (NumClrs - 1) + 1)
- Else
- ' Use the background color.
- bytes(i, j) = ok_clr(0)
- End If
-
- ImaZ0 = ImaZ0 + dImaZ0
- Next j
- ReaZ0 = ReaZ0 + dReaZ0
-
- ' Let the user know we're not dead.
- '@ If i Mod 10 = 0 Then
- '@ status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
- '@ Canvas.Refresh
- '@ End If
- Next i
- ' Update the image.
- status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
- Canvas.Refresh
- Caption = "Julia (" & Format$(Xmin) & ", " & Format$(Ymin) & ")-(" & Format$(Xmax) & ", " & Format$(Ymax) & ")"
- WaitEnd
- End Sub
- ' ************************************************
- ' Fill in an array with the indexes of the static
- ' colors we want to use.
- ' ************************************************
- Sub InitColors()
- NumClrs = 16
- ReDim ok_clr(0 To NumClrs - 1)
- ok_clr(0) = 0 ' Black
- ok_clr(1) = 1 ' Dark red
- ok_clr(2) = 2 ' Dark green
- ok_clr(3) = 3 ' Dark yellow
- ok_clr(4) = 4 ' Dark blue
- ok_clr(5) = 5 ' Dark magenta
- ok_clr(6) = 6 ' Dark cyan
- ' ok_clr( ) = 7 ' Light gray
- ' ok_clr( ) = 8 ' Money green
- ok_clr(7) = 9 ' Sky blue
- ok_clr(8) = 246 ' Cream
- ' ok_clr( ) = 247 ' Light gray
- ' ok_clr( ) = 248 ' Medium gray
- ok_clr(9) = 249 ' Red
- ok_clr(10) = 250 ' Green
- ok_clr(11) = 251 ' Yellow
- ok_clr(12) = 252 ' Blue
- ok_clr(13) = 253 ' Magenta
- ok_clr(14) = 254 ' Cyan
- ok_clr(15) = 255 ' White
- End Sub
- ' ************************************************
- ' Start a rubberband box to select a zoom area.
- ' ************************************************
- Private Sub Canvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- DrawingBox = True
- StartX = X
- StartY = Y
- CurX = X
- CurY = Y
- Canvas.Line (StartX, StartY)-(CurX, CurY), , B
- End Sub
- ' ************************************************
- ' Continue the zoom area rubberband box.
- ' ************************************************
- Private Sub Canvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
- If Not DrawingBox Then Exit Sub
- Canvas.Line (StartX, StartY)-(CurX, CurY), , B
- CurX = X
- CurY = Y
- Canvas.Line (StartX, StartY)-(CurX, CurY), , B
- End Sub
- ' ************************************************
- ' Zoom in on the selected area.
- ' ************************************************
- Private Sub Canvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- Dim x1 As Single
- Dim x2 As Single
- Dim y1 As Single
- Dim y2 As Single
- Dim factor As Single
- If Not DrawingBox Then Exit Sub
- DrawingBox = False
- Canvas.Line (StartX, StartY)-(CurX, CurY), , B
- CurX = X
- CurY = Y
- ' Put the coordinates in proper order.
- If CurX < StartX Then
- x1 = CurX
- x2 = StartX
- Else
- x1 = StartX
- x2 = CurX
- End If
- If x1 = x2 Then x2 = x1 + 1
- If CurY < StartY Then
- y1 = CurY
- y2 = StartY
- Else
- y1 = StartY
- y2 = CurY
- End If
- If y1 = y2 Then y2 = y1 + 1
- ' Convert screen coords into drawing coords.
- factor = (Xmax - Xmin) / Canvas.ScaleWidth
- Xmax = Xmin + x2 * factor
- Xmin = Xmin + x1 * factor
- factor = (Ymax - Ymin) / Canvas.ScaleHeight
- Ymax = Ymin + y2 * factor
- Ymin = Ymin + y1 * factor
- DrawCurve
- End Sub
- ' ************************************************
- ' Force Visual Basic to resize the bitmap.
- ' ************************************************
- Private Sub Canvas_Resize()
- Canvas.Cls
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- End
- End Sub
- ' ************************************************
- ' Allow the user to pick the colors in use.
- ' ************************************************
- Private Sub mnuOptColors_Click()
- Dim frm As New ColorForm
- Dim i As Integer
- frm.Show vbModal
- If frm.Canceled Then Exit Sub
- ' See which colors were selected.
- NumClrs = 0
- For i = 0 To 9
- If frm.ColorCheck(i).value = vbChecked Then _
- NumClrs = NumClrs + 1
- Next i
- For i = 246 To 255
- If frm.ColorCheck(i).value = vbChecked Then _
- NumClrs = NumClrs + 1
- Next i
- ' If the user didn't pick at least 2 colors,
- ' use black and white.
- If NumClrs < 2 Then
- NumClrs = 2
- frm.ColorCheck(0).value = vbChecked
- frm.ColorCheck(255).value = vbChecked
- End If
- ' Create the ok_clr array.
- ReDim ok_clr(0 To NumClrs - 1)
- NumClrs = 0
- For i = 0 To 9
- If frm.ColorCheck(i).value = vbChecked Then
- ok_clr(NumClrs) = i
- NumClrs = NumClrs + 1
- End If
- Next i
- For i = 246 To 255
- If frm.ColorCheck(i).value = vbChecked Then
- ok_clr(NumClrs) = i
- NumClrs = NumClrs + 1
- End If
- Next i
- Unload frm
- End Sub
- ' ***********************************************
- ' Load a new data file.
- ' ***********************************************
- Private Sub mnuFileSaveAs_Click()
- Dim fname As String
- ' Allow the user to pick a file.
- On Error Resume Next
- FileDialog.filename = "*.BMP"
- FileDialog.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
- FileDialog.ShowSave
- If Err.Number = cdlCancel Then
- Exit Sub
- ElseIf Err.Number <> 0 Then
- Beep
- MsgBox "Error selecting file.", , vbExclamation
- Exit Sub
- End If
- On Error GoTo 0
- fname = Trim$(FileDialog.filename)
- FileDialog.InitDir = Left$(fname, Len(fname) _
- - Len(FileDialog.FileTitle) - 1)
- ' Save the picture.
- SavePicture Canvas.Image, fname
- End Sub
- ' ***********************************************
- ' Give the form and all the picture boxes an
- ' hourglass cursor.
- ' ***********************************************
- Sub WaitStart()
- MousePointer = vbHourglass
- Canvas.MousePointer = vbHourglass
- DoEvents
- End Sub
- ' ***********************************************
- ' Restore the mouse pointers for the form and all
- ' the picture boxes.
- ' ***********************************************
- Sub WaitEnd()
- MousePointer = vbDefault
- Canvas.MousePointer = vbCrosshair
- End Sub
- ' ************************************************
- ' Draw the initial Julia set.
- ' ************************************************
- Private Sub Form_Load()
- Me.Show
- DoEvents
- MaxIter = 64
- ' Put the system static colors in the palette.
- PreparePalette Canvas
- ' Display the first Julia set.
- InitColors
- mnuScaleFull_Click
- End Sub
- Private Sub Form_Resize()
- Canvas.Move 0, 0, ScaleWidth, ScaleHeight
- 'Canvas.Refresh
- End Sub
- Private Sub mnuFileExit_Click()
- Unload Me
- End Sub
- ' ************************************************
- ' Let the user set the maximum number of
- ' iterations.
- ' ************************************************
- Private Sub mnuOptIter_Click()
- Dim txt As String
- Dim value As Integer
- txt = InputBox("Maximum number of iterations:", _
- "Iterations", Format$(MaxIter))
- If txt = "" Then Exit Sub
- If IsNumeric(txt) Then value = CInt(txt)
- If value > 0 Then
- MaxIter = value
- Else
- Beep
- End If
- End Sub
- ' ************************************************
- ' Display the Julia set.
- ' ************************************************
- Private Sub mnuOptJulia_Click()
- ' If we are displaying a Mandelbrot set,
- ' use the center as C for the Julia set.
- If Not DrawingJulia Then
- ReaC = (Xmin + Xmax) / 2
- ImaC = (Ymin + Ymax) / 2
- End If
- mnuOptJulia.Checked = True
- mnuOptMandelbrot.Checked = False
- DrawingJulia = True
- mnuScaleFull_Click
- End Sub
- ' ************************************************
- ' Display the Mandelbrot set.
- ' ************************************************
- Private Sub mnuOptMandelbrot_Click()
- mnuOptJulia.Checked = False
- mnuOptMandelbrot.Checked = True
- DrawingJulia = False
- mnuScaleFull_Click
- End Sub
- ' ************************************************
- ' Zoom out to full scale.
- ' ************************************************
- Private Sub mnuScaleFull_Click()
- If DrawingJulia Then
- Xmin = -1.5
- Xmax = 1.5
- Ymin = -1.5
- Ymax = 1.5
- Else
- Xmin = -2
- Xmax = 1.2
- Ymin = -1.2
- Ymax = 1.2
- End If
- DrawCurve
- End Sub
- ' ************************************************
- ' Make a series of images.
- ' ************************************************
- Private Sub MakeMovie(fname As String)
- Dim num_frames As Integer
- Dim frame As Integer
- Dim fraction As Single ' Amount to reduce image.
- Dim xmid As Single ' Center of image.
- Dim ymid As Single
- Dim wid1 As Single ' Starting dimensions.
- Dim hgt1 As Single
- Dim wid2 As Single ' Finishing dimensions.
- Dim hgt2 As Single
- Dim wid As Single ' Current dimensions.
- Dim hgt As Single
- Dim start_time As Single
- Dim stop_time As Single
- Dim max_time As Single
- Dim min_time As Single
- Dim txt As String
- Dim value As Integer
- ' See how may frames the user wants.
- txt = InputBox("Number of frames:", _
- "Frames", "20")
- If txt = "" Then Exit Sub
- If IsNumeric(txt) Then num_frames = CInt(txt)
- If num_frames < 1 Then num_frames = 20
- WaitStart
- max_time = 0
- min_time = 100000
-
- ' Set the center of focus and dimensions.
- xmid = (Xmin + Xmax) / 2
- ymid = (Ymin + Ymax) / 2
- wid1 = 3
- wid2 = 0.1
- ' Compute start and finish heights.
- hgt1 = wid1 * Canvas.ScaleHeight / Canvas.ScaleWidth
- hgt2 = wid2 * Canvas.ScaleHeight / Canvas.ScaleWidth
- ' Compute the amount to reduce the image for
- ' each frame.
- fraction = Exp(Log(wid2 / wid1) / num_frames)
- ' Start cranking out frames.
- wid = wid1
- hgt = hgt1
- For frame = 0 To num_frames - 1
- Caption = "Julia" & Str$(frame) & _
- "/" & Format$(num_frames - 1)
-
- Xmin = xmid - wid / 2
- Xmax = xmid + wid / 2
- Ymin = ymid - hgt / 2
- Ymax = ymid + hgt / 2
-
- start_time = Timer
- DrawJulia
- stop_time = Timer
-
- If min_time > stop_time - start_time Then min_time = stop_time - start_time
- If max_time < stop_time - start_time Then max_time = stop_time - start_time
-
- SavePicture Canvas.Image, _
- fname & Format$(frame) & ".bmp"
- Beep
- DoEvents
-
- wid = wid * fraction
- hgt = hgt * fraction
- Next frame
- WaitEnd
- MsgBox _
- "Longest: " & Format$(max_time, "0.00") & _
- " seconds." & vbCrLf & _
- "Shortest: " & Format$(min_time, "0.00") & _
- " seconds." & vbCrLf
- End Sub
- ' ************************************************
- ' Make a series of images.
- ' ************************************************
- Private Sub mnuMovieCreate_Click()
- Dim oldtitle As String
- Dim fname As String
- Dim pos As Integer
- ' Allow the user to pick a file.
- On Error Resume Next
- oldtitle = FileDialog.DialogTitle
- FileDialog.DialogTitle = "Select base file name (no number)"
- FileDialog.filename = "*.BMP"
- FileDialog.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
- FileDialog.ShowSave
- FileDialog.DialogTitle = oldtitle
- If Err.Number = cdlCancel Then
- Exit Sub
- ElseIf Err.Number <> 0 Then
- Beep
- MsgBox "Error selecting file.", , vbExclamation
- Exit Sub
- End If
- On Error GoTo 0
- fname = Trim$(FileDialog.filename)
- FileDialog.InitDir = Left$(fname, Len(fname) _
- - Len(FileDialog.FileTitle) - 1)
- ' Trim off the extension if any.
- pos = InStr(fname, ".")
- If pos > 0 Then fname = Left$(fname, pos - 1)
- ' Add a trailing underscore if needed.
- If Right$(fname, 1) <> "_" Then _
- fname = fname & "_"
- ' Make the movie.
- MakeMovie fname
- End Sub
- ' ************************************************
- ' Increase the area shown by a factor of Index.
- ' ************************************************
- Private Sub mnuScale_Click(index As Integer)
- Dim size As Single
- Dim mid As Single
- size = index * (Xmax - Xmin)
- If size > 3.2 Then
- mnuScaleFull_Click
- Exit Sub
- End If
- mid = (Xmin + Xmax) / 2
- Xmin = mid - size / 2
- Xmax = mid + size / 2
- size = index * (Ymax - Ymin)
- If size > 2.4 Then
- mnuScaleFull_Click
- Exit Sub
- End If
- mid = (Ymin + Ymax) / 2
- Ymin = mid - size / 2
- Ymax = mid + size / 2
- DrawCurve
- End Sub
-